home *** CD-ROM | disk | FTP | other *** search
Text File | 1996-05-21 | 3.9 KB | 133 lines | [TEXT/ttxt] |
- -- <<<
-
- object cantChangeOrder (CollectionException)
- name:"cantChangeOrder"
- format:"Attempt to sort or change the order of a collection"
- end
-
- class UniformCollection (IndirectCollection)
- instance vars
- keyType -- class to which keys must belong
- valueType -- class to which values must belong
-
- instance methods
- method init self #rest args #key keyType: valueType: -> (
- apply nextMethod self args
- if isAKindof self.targetCollection \
- ImplicitlyKeyedCollection then (
- self.keyType := @implicit
- )
- else (
- if keyType = unsupplied then
- report keywordRequired @keytype
- else if isAKindOf keyType Behavior then
- self.keyType := keyType
- else
- report badParameter #(keyType, init, self,
- "keyType must be a class.")
- )
- if valueType = unsupplied then
- report keywordRequired @valueType
- else if isAKindOf valueType Behavior then
- self.valueType := valueType
- else
- report badParameter #(valueType, init, self,
- "valueType must be a class.")
- )
- -- keyUniformityGetter and uniformityGetter can be
- -- specialized at the class or instance level
- method keyUniformityGetter self -> @sameClass
- method keyUniformityClassGetter self -> self.keyType
- method uniformityGetter self -> @sameClass
- method uniformityClassGetter self -> self.valueType
- method isAppropriateObject self addedObject -> (
- case (self.uniformity) of
- @sameClass: (
- if (getClass addedObject == self.valueType) then
- return true
- else
- return false
- )
- @commonSuperclass:(
- if (isAKindOf addedObject self.valueType) then
- return true
- else
- return false
- )
- otherwise:
- report generalError \
- "inappropriate value for uniformity"
- end
- )
- method add self key value -> (
- if self.keyType == @implicit then (
- nextMethod self key value
- )
- else (
- case (self.keyUniformity) of
- @sameClass: (
- if (getClass key == self.keyType) then
- nextMethod self key value
- else
- report badkey (#(self, key) as Pair)
- )
- @commonSuperclass:(
- if (isAKindOf key self.keyType) then
- nextMethod self key value
- else
- report badkey (#(self, key) as Pair)
- )
- otherwise:
- report generalError \
- "inappropriate value for keyUniformity"
- end
- )
- )
- -- reports the cantChangeOrder exception
- method repXcantChangeOrder self ->
- report cantChangeOrder undefined
-
- -- the rest of these are error checking to
- -- prevent invalid calls on the collection
- method addNth self ordinal value -> repXcantChangeOrder self
- method append self value -> repXcantChangeOrder self
- method appendNew self value -> repXcantChangeOrder self
- method moveBackward self value -> repXcantChangeOrder self
- method moveForward self value -> repXcantChangeOrder self
- method moveToBack self value -> repXcantChangeOrder self
- method moveToFront self value -> repXcantChangeOrder self
- method prepend self value -> repXcantChangeOrder self
- method prependNew self value -> repXcantChangeOrder self
- method setLast self value -> repXcantChangeOrder self
- method setNth self ordinal value -> repXcantChangeOrder self
- method sort self ltFunction -> repXcantChangeOrder self
- end
-
-
-
- -- examples of usage
- global myArray := new UniformCollection \
- targetCollection:(new Array initialSize:10) \
- valueType:String
- method uniformityGetter self {object myArray} -> @commonSuperClass
- add myArray empty ("Grok" as String)
- add myArray 1 "Voodoo"
- global myBtree := new UniformCollection \
- targetCollection:(new BTree) \
- keyType:NameClass \
- valueType:String
- add myBtree @elephant ("Trunk" as String)
- -- test that you cannot add a StringConstant value to myBTree
- guard (
- add myBtree @pig "Snout"
- print "this line should not print!"
- )
- catching
- all: (
- print "attempt to give a pig a snout foiled"
- add myBtree @pig ("Tail" as String)
- caught undefined
- )
- end
- -- >>>
-